unit wgetidri;

{****************************************************************************}

interface

uses Wincrt,Windos,
      CartoCmds,        (* Contient les def. globales *)
      tit_win,get_win,gmuf_win,aux_win,coul_win;


(*************************** gethff - 3 Nov 90 *****************************)

function get_idri(docfile_name:st64;var nlig_capt,ncol_capt : word;
                   var title_idri:string; var ipol:integer; leg_idri:pptable;
                   var FileFormat, PixelFormat : integer): integer;

{****************************************************************************}

implementation

(*************************** getbmp - 5 Juin 91 *****************************)

function get_idri(docfile_name:st64;var nlig_capt, ncol_capt : word;
                   var title_idri:string; var ipol:integer; leg_idri:pptable;
                   var FileFormat, PixelFormat : integer): integer;

var


    ref_units                               : string[3];
    val_units,ref_system,flag_defn          : string[66];
    val_recs,rows,cols                      : longint;
    val_fields,val_file_type                : byte;
    legend,data_format,geo_type             : integer;
    old_data_type,old_file_type             : integer;
    new_data_type,new_file_type             : integer;
    wxmin,wxmax,wymin,wymax,unit_dist       : real;
    flag_value,resolution,cellx,celly       : real;
    posn_error,val_error,min,max            : real;
    posn_error_flag, resolution_flag,
     val_error_flag, flag_flag              : boolean;
(*
    legend_text                             : array [0..255] of string[66];
*)
    legend_text                             : string;

label 999;

{***************************************************************************}
procedure print_documentation_file;

var
    i              : integer;

begin


  if ((new_data_type=0) and (new_file_type=1)) then new_data_type:=2;

  _writeln('file title  : '+title_idri);
  case new_data_type of
  0 : _writeln('data type   : integer');
  1 : _writeln('data type   : real');
  2 : _writeln('data type   : byte');
  end;

  case new_file_type of
  0 : _writeln('file type   : ascii');
  1 : _writeln('file type   : binary');
  2 : _writeln('file type   : packed binary');
  end;

  str(cols,strw); _writeln('columns     : '+strw);
  str(rows,strw); _writeln('rows        : '+strw);

  _writeln('ref. system : '+ref_system);
  _writeln('ref. units  : '+ref_units);
  {*** note that both ref_system and ref_units MUST be in LOWER CASE ***}

  str(unit_dist:9:7,strw); _writeln('unit dist.  : '+strw);
  str(wxmin:9:7,strw); _writeln('min. X      : '+strw);
  str(wxmax:9:7,strw); _writeln('max. X      : '+strw);
  str(wymin:9:7,strw); _writeln('min. Y      : '+strw);
  str(wymax:9:7,strw); _writeln('max. Y      : '+strw);

  if posn_error_flag then begin
                       str(posn_error:9:7,strw);
                       _writeln('pos''n error : '+strw)
                     end else _writeln('pos''n error : unknown');
  if resolution_flag then begin
                       str(resolution:9:7,strw);
                       _writeln('resolution  : '+strw)
                     end else _writeln('resolution  : unknown');
  if new_data_type=1 then begin
                       str(min:9:7,strw);
                       _writeln('min. value  : '+strw)
                     end else begin
                       str(min:1:0,strw);
                       _writeln('min. value  : '+strw);
                     end;
  str(max:9:7,strw);
  if new_data_type=1 then _writeln('max. value  : '+strw)
                     else begin
                       str(max:1:0,strw);
                       _writeln('max. value  : '+strw);
                     end;
  if val_units='' then _writeln('value units : unspecified')
                  else _writeln('value units : '+val_units);
  {*** note that val_units MUST be in LOWER CASE ***}

  _write('value error : ');
  if not val_error_flag then _writeln('unknown') else begin
    str(val_error:9:7,strw);
    _writeln(strw);
  end;

  _write('flag value  : ');
  if not flag_flag then _writeln('none') else
    begin
     str(flag_value:9:7,strw);
     if new_data_type=1 then _writeln(strw)
                        else begin
                          str(flag_value:1:0,strw);
                          _writeln(strw);
                        end;
    end;

  if flag_defn='' then _writeln('flag def''n  : none')
                   else _writeln('flag def''n  : '+flag_defn);
(*
  writeln('legend cats : ',legend);
  if legend<>0 then begin
    if legend>255 then legend:=255;
    for i:=0 to (legend-1) do begin
      write('category',i:3,' : ');
      writeln(legend_text[i]);
    end; {for}
    end;
*)
end;


{***************************************************************************}
function read_docfile(doc_filename:string):integer;

var
    docfile     : text;
    description : string[14];
    i,err_code  : integer;
    tmpstr      : string[66];
label 999;

begin

  read_docfile := -1;

{$I-}

  assign(docfile,doc_filename);
  reset(docfile);
  if ioresult <> 0 then goto 999;

  read(docfile, description); readln(docfile,title_idri);
  read(docfile,description);  readln(docfile,description);
  if description <> 'byte' then begin
    _writeln('Error : The '+description+' data type is not supported by this module');
    read_docfile := -2;
    goto 999;
  end;
  old_data_type:=2;

  read(docfile,description); readln(docfile,description);

  if description <> 'binary' then begin
    _writeln('Error : The '+description+' file type is not supported by this module');
    read_docfile := -3;
    goto 999;
  end;
  old_file_type:=1;

  read(docfile,description);
  if description = 'columns     : ' then readln(docfile,cols) else readln(docfile,rows);
  read(docfile,description);
  if description = 'rows        : ' then readln(docfile,rows) else readln(docfile,cols);
  read(docfile,description);readln(docfile,ref_system);

  read(docfile,description);readln(docfile,tmpstr);
  for i:=1 to length(tmpstr) do tmpstr[i]:=upcase(tmpstr[i]);
  if ((tmpstr='M') or (tmpstr='FT') or (tmpstr='MI')
  or (tmpstr='KM') or (tmpstr='DEG') or (tmpstr='RAD')) then
    ref_units:=tmpstr else ref_units := '  ';

  read(docfile,description);readln(docfile,unit_dist);
  read(docfile,description);readln(docfile,wxmin);
  read(docfile,description);readln(docfile,wxmax);
  read(docfile,description);readln(docfile,wymin);
  read(docfile,description);readln(docfile,wymax);
  cellx:=(wxmax-wxmin)/cols;
  celly:=(wymax-wymin)/rows;

  read(docfile,description);readln(docfile,tmpstr);
    posn_error_flag:=false;posn_error:=0;
    for i:=length(tmpstr) downto 1 do if tmpstr[i]=' ' then delete(tmpstr,i,1);
    val(tmpstr,posn_error,err_code);
    if err_code=0 then posn_error_flag:=true;

  read(docfile,description);readln(docfile,tmpstr);
    resolution_flag:=false;resolution:=0;
    for i:=length(tmpstr) downto 1 do if tmpstr[i]=' ' then delete(tmpstr,i,1);
    val(tmpstr,resolution,err_code);
    if err_code=0 then resolution_flag:=true;

  read(docfile,description);readln(docfile,min);
  read(docfile,description);readln(docfile,max);
  read(docfile,description);readln(docfile,val_units);

  read(docfile,description);readln(docfile,tmpstr);
    val_error_flag:=false;val_error:=0;
    for i:=length(tmpstr) downto 1 do if tmpstr[i]=' ' then delete(tmpstr,i,1);
    val(tmpstr,val_error,err_code);
    if err_code=0 then val_error_flag:=true;

  read(docfile,description);readln(docfile,tmpstr);
    flag_flag:=false;flag_value:=0;
    for i:=length(tmpstr) downto 1 do if tmpstr[i]=' ' then delete(tmpstr,i,1);
    val(tmpstr,flag_value,err_code);
    if err_code=0 then flag_flag:=true;

  read(docfile,description);readln(docfile,flag_defn);
  read(docfile,description);readln(docfile,legend);

  ipol := 0;
  if legend<>0 then begin
    if legend>255 then legend:=255;
    ipol := 1;
    for i:=0 to (legend-1) do begin read(docfile,description);
           readln(docfile,legend_text);
           _nextpar(strw,legend_text); _nextpar(strw,legend_text);
           leg_idri^[i] := strw;
         end; {for}
    end;

  close (docfile);
  read_docfile := 0;

999:end;

{***************************************************************************}

begin

  get_idri := 1;

  ncol_capt := 0;
  nlig_capt := 0;

    ier := read_docfile(docfile_name);
    if ier <> 0 then goto 999;
    print_documentation_file;

  ncol_capt := cols;
  nlig_capt := rows;

  get_idri := 0;

999:end;

end.
